library(sloop)
13 S3
Introduction
R 的第一个OOP是S3面向对象,它的唯一优点是极其简单——无法再扔掉它的任何一部分来实现OOP。S3面向对象是R base
和stats
包中唯一使用的OOP。
S3面向对象不像其他语言中那么严格,赋予了R编程人员很大的自由,这是危险的;为了能更好的使用S3面向对象,本章会介绍使用S3面向对象时约定的惯例。
本章的目的也仅是对S3面向对象如何工作进行介绍,不涉及如何有效地创建新的S3类。
Outline
- 13.2节:总览S3类——类,泛型函数,方法
- 13.3节:创建新的S3类时的细节,三个函数:constructor,helper,validator
- 13.4节:介绍类与方法如何工作(方法派发),method dispatch
- 13.5节:S3类的四种主要风格:vector,record,data frame,scalar
- 13.6节:介绍S3的继承及如何添加类的关系
- 13.7节:详细介绍类方法分派
Prerequisites
S3类与class
属性密不可分,我们需要使用sloop
包来查看S3类的内部结构。
Basics
类,属性
S3对象是一个至少有1个class
属性的base type。例如factor,它的base type是integer
,除此之外还有class
属性和levels
属性。
<- factor(c("a", "b", "c"))
f
typeof(f)
#> [1] "integer"
attributes(f)
#> $levels
#> [1] "a" "b" "c"
#>
#> $class
#> [1] "factor"
使用unclass()
可以去除S3对象的class
属性,暴露出其底层的base type,同时失去对象的特有行为。
unclass(f)
#> [1] 1 2 3
#> attr(,"levels")
#> [1] "a" "b" "c"
方法
S3类方法的实现是基于“泛型函数”的。识别泛型函数的一种简单方法是使用sloop::ftype()
,如果结果中有”generic”字样,就是泛型函数。
ftype(print)
#> [1] "S3" "generic"
ftype(str)
#> [1] "S3" "generic"
ftype(unclass)
#> [1] "primitive"
不同S3对象输入到同一个泛型函数时会产生不同的结果(多态)。底层逻辑是,根据对象class
属性,选择对应的方法。许多R函数属于泛型函数,例如print()
。
print(f)
#> [1] a b c
#> Levels: a b c
# stripping class reverts to integer behaviour
print(unclass(f))
#> [1] 1 2 3
#> attr(,"levels")
#> [1] "a" "b" "c"
我们知道面向对象系统有一个重要特征——“封装”。S3系统的泛型函数同样具有封装的特性,会隐藏对象中的细节。例如常用的泛型函数str()
,虽然是用来查看对象的结构,但你所看到的是对象想让你看到的,没有展示对象内部详细的细节。POSIXlt
类用来表示时间,使用str()
只能看到年月日,但其底层是一个list
。
<- strptime(c("2017-01-01", "2020-05-04 03:21"), "%Y-%m-%d")
time str(time)
#> POSIXlt[1:2], format: "2017-01-01" "2020-05-04"
str(unclass(time))
#> List of 11
#> $ sec : num [1:2] 0 0
#> $ min : int [1:2] 0 0
#> $ hour : int [1:2] 0 0
#> $ mday : int [1:2] 1 4
#> $ mon : int [1:2] 0 4
#> $ year : int [1:2] 117 120
#> $ wday : int [1:2] 0 1
#> $ yday : int [1:2] 0 124
#> $ isdst : int [1:2] 0 0
#> $ zone : chr [1:2] "UTC" "UTC"
#> $ gmtoff: int [1:2] NA NA
#> - attr(*, "tzone")= chr [1:3] "" "UTC" "UTC"
#> - attr(*, "balanced")= logi TRUE
方法派发
泛型函数会为不同类找到正确的实现,类的特定实现称为方法(method),泛型函数通过执行方法分派(method dispatch)来找到对应的方法。
可以使用sloop::s3_dispatch()
函数查看方法派发的过程。如下面所示,找到了当前print的多个方法print.factor
和print.default
,最终选择了print.factor
。
s3_dispatch(print(f))
#> => print.factor
#> * print.default
从结果中可以看到,泛型函数的命名规则是generic.class()
。通常你无需使用generic.class()
形式的函数,只需使用generic()
,它会根据输入对象的class
属性自动识别。因为某些函数的定义早于S3系统,所以类型<>.<>
的函数不都是泛函,可以使用sloop::ftype()
进行识别。
ftype(t.test)
#> [1] "S3" "generic"
ftype(t.data.frame)
#> [1] "S3" "method"
S3 系统的泛函通常无法看到源码,但是可以使用sloop::s3_get_method()
查看。
weighted.mean.Date#> Error: object 'weighted.mean.Date' not found
s3_get_method(weighted.mean.Date)
#> function (x, w, ...)
#> .Date(weighted.mean(unclass(x), w, ...))
#> <bytecode: 0x5ac8d12d7770>
#> <environment: namespace:stats>
Classes
S3面向对象实例化一个对象只能使用structure()
或calss<-()
函数——通过设置class
属性的方法实现。
# Create and assign class in one step
<- structure(list(), class = "my_class")
x
# Create, then set class
<- list()
x class(x) <- "my_class"
使用class()
查看一个对象的类型,使用inherits(x, "classname")
来判断一个对象是否属于某类。
class(x)
#> [1] "my_class"
inherits(x, "my_class")
#> [1] TRUE
inherits(x, "your_class")
#> [1] FALSE
classname 可以是任意字符串,但是推荐使用字姆和_
,杜绝使用.
。在package中使用class时,推荐加上包名。
S3面向对象没有类正确性检查,意味着可以随意更改一个对象的类:
# Create a linear model
<- lm(log(mpg) ~ log(disp), data = mtcars)
mod class(mod)
#> [1] "lm"
print(mod)
#>
#> Call:
#> lm(formula = log(mpg) ~ log(disp), data = mtcars)
#>
#> Coefficients:
#> (Intercept) log(disp)
#> 5.3810 -0.4586
# Turn it into a date (?!)
class(mod) <- "Date"
# Unsurprisingly this doesn't work very well
print(mod)
#> Error in as.POSIXlt(.Internal(Date2POSIXlt(x, tz)), tz = tz): 'list' object cannot be coerced to type 'double'
为了避免上述问题发生,推荐创建三个函数:
- 低级构造函数(Constructor),
new_myclass()
:高效地创建结构正确的类。 - 验证函数(validator),
validate_myclass()
:验证类的合法性。 - 帮助函数(helper),
myclass()
:用户友好的创建类。
Constructors
S3 面向对象没有提供正式的类定义函数,无法保证类的结构统一,我们需要自行创建一个构造函数,保证类的构造正确。构造函数应当遵循下面三条原则:
- 函数命名为
new_myclass()
样式。 - 一个参数服务于构成类的base type;每个属性一个参数。
- 检查base type和每个参数的类型是否符合要求。
下面是一个具有units属性,class属性为difftime
的类构造函数:
<- function(x = double(), units = "secs") {
new_difftime stopifnot(is.double(x))
<- match.arg(units, c("secs", "mins", "hours", "days", "weeks"))
units
structure(x,
class = "difftime",
units = units
)
}
new_difftime(c(1, 10, 3600), "secs")
#> Time differences in secs
#> [1] 1 10 3600
new_difftime(52, "weeks")
#> Time difference of 52 weeks
构造函数面向的是开发者,这意味着,有些时候,我们可以牺牲一些安全性来换取高效性,例如避免耗时项的检查。
Validators
越复杂的类越需要细致地检查。如下例factor类,虽然有对输入类型检查,但仍然创建了错误的类。
<- function(x = integer(), levels = character()) {
new_factor stopifnot(is.integer(x))
stopifnot(is.character(levels))
structure(
x,levels = levels,
class = "factor"
)
}
new_factor(1:5, "a")
#> Error in as.character.factor(x): malformed factor
new_factor(0:1, "a")
#> Error in as.character.factor(x): malformed factor
想比于构造函数中对base type和参数类型的检查,对类输入的其他检查应该分离为单独的函数。这样当你知道输入是正确时,可以以更低的成本创建类,并且检查方法可以用在其他地方。
<- function(x) {
validate_factor <- unclass(x)
values <- attr(x, "levels")
levels
if (!all(!is.na(values) & values > 0)) {
stop(
"All `x` values must be non-missing and greater than zero",
call. = FALSE
)
}
if (length(levels) < max(values)) {
stop(
"There must be at least as many `levels` as possible values in `x`",
call. = FALSE
)
}
x
}
validate_factor(new_factor(1:5, "a"))
#> Error: There must be at least as many `levels` as possible values in `x`
validate_factor(new_factor(0:1, "a"))
#> Error: All `x` values must be non-missing and greater than zero
Helpers
为了方便使用者创建类对象,我们需要提供一个帮助函数。其遵循以下原则:
- 函数名和类名相同,
myclass()
。 - 如果存在constructor和validator,函数要使用它们。
- 为终端用户创建精心设计的错误消息。。
- 有一个精心设计的用户界面,精心选择的默认值和有用的转换
下面是三个常见的示例:
输入参数类型强制转换
例如上面的new_difftime()
对输入十分严格,当输入是integer时报错。
new_difftime(1:10)
#> Error in new_difftime(1:10): is.double(x) is not TRUE
可以在helper函数中添加类型强制转换:
<- function(x = double(), units = "secs") {
difftime <- as.double(x)
x new_difftime(x, units = units)
}
difftime(1:10)
#> Time differences in secs
#> [1] 1 2 3 4 5 6 7 8 9 10
提供有用的默认值
在生成factor时,提供默认的levels。
<- function(x = character(), levels = unique(x)) {
factor <- match(x, levels)
ind validate_factor(new_factor(ind, levels))
}
factor(c("a", "a", "b"))
#> [1] a a b
#> Levels: a b
使用简单成分组成用户界面
下面是一个构建POSIXct
类的函数,函数的输入都是简单的整数。
<- function(year = integer(),
POSIXct month = integer(),
day = integer(),
hour = 0L,
minute = 0L,
sec = 0,
tzone = "") {
ISOdatetime(year, month, day, hour, minute, sec, tz = tzone)
}
POSIXct(2020, 1, 1, tzone = "America/New_York")
#> [1] "2020-01-01 EST"
Generics and methods
如上所述,S3系统的泛型函数会执行方法分派——找到类能使用的方法,该过程由UseMethod()
函数实现。UseMethod()
函数有两个参数:
- generic:字符串类型的泛型函数名称。
- object:要分派的对象。
通常只需要第一个参数,例如mean()
:
mean#> function (x, ...)
#> UseMethod("mean")
#> <bytecode: 0x5ac8d0d1c028>
#> <environment: namespace:base>
创建自己的泛型函数,在创建时,泛型函数的参数不需要传递到UseMethod()
中。
<- function(x) {
my_new_generic UseMethod("my_new_generic")
}
泛型函数内不要添加额外的处理逻辑,这会导致不可预的意外,例如下面的泛型函数g()
,你无法修改变量y
的值。
<- function(x) {
g <- 10
x <- 10
y UseMethod("g")
}<- function(x) c(x = x, y = y)
g.default
<- 1
x <- 1
y g(x)
#> x y
#> 1 1
Method dispath
UseMethod()
执行方法派发的原理:创建泛型函数拥有的方法向量(generic.class
),寻找潜在可用的方法。使用sloop::s3_dispath()
可以查看这一过程。
<- Sys.Date()
x s3_dispatch(print(x))
#> => print.Date
#> * print.default
=>
表示该方法被调用*
表示该方法被定义但未被调用
“default” class是特殊的伪类,它不是真实存在的类;包含它是为了使定义一个标准回退成为可能,这个回退在特定类的方法不可用时可以找到。例如下面的test
类,在执行t()
时,会自动为其分配t.default()
方法,而不是R 4.0.0版本前的将t.test()
当作方法进行派发。
<- structure(1:10, class = "test")
x s3_dispatch(t(x))
#> t.test
#> => t.default
# Output in R version 3.6.2
<- structure(1:10, class = "test")
x t(x)
#>
#> One Sample t-test
#>
#> data: x
#> t = 5.7446, df = 9, p-value = 0.0002782
#> alternative hypothesis: true mean is not equal to 0
#> 95 percent confidence interval:
#> 3.334149 7.665851
#> sample estimates:
#> mean of x
#> 5.5
方法派发的本质相当简单,但随着本章的深入,你会发现它在包含继承、基类型、内部泛型和组泛型方面变得越来越复杂。下面的代码展示了几个更复杂的情况,我们将在后续13.7节和14章中详细介绍。
<- matrix(1:10, nrow = 2)
x s3_dispatch(mean(x))
#> mean.matrix
#> mean.integer
#> mean.numeric
#> => mean.default
s3_dispatch(sum(Sys.time()))
#> sum.POSIXct
#> sum.POSIXt
#> sum.default
#> => Summary.POSIXct
#> Summary.POSIXt
#> Summary.default
#> -> sum (internal)
Finding methods
sloop::s3_methods_generic()
函数可以查看一个generic函数的所有方法。sloop::s3_methods_class()
函数可以查看一个class的所有方法。
s3_methods_generic("mean")
#> # A tibble: 7 × 4
#> generic class visible source
#> <chr> <chr> <lgl> <chr>
#> 1 mean Date TRUE base
#> 2 mean default TRUE base
#> 3 mean difftime TRUE base
#> 4 mean POSIXct TRUE base
#> 5 mean POSIXlt TRUE base
#> 6 mean quosure FALSE registered S3method
#> # ℹ 1 more row
s3_methods_class("ordered")
#> # A tibble: 4 × 4
#> generic class visible source
#> <chr> <chr> <lgl> <chr>
#> 1 as.data.frame ordered TRUE base
#> 2 Ops ordered TRUE base
#> 3 relevel ordered FALSE registered S3method
#> 4 Summary ordered TRUE base
Creating methods
创建自己类的方法格式为:
<- function(generic_params) {
generic_name.class_name # do something
}
在创建新方法时要注意:
首先,只有当你拥有泛型函数或类时,才应该编写方法。虽然即使你不拥有某个类或泛型函数,R 也会允许你定义方法,但这是极其不礼貌的行为。相反,请与泛型函数或类的作者合作,在他们的代码中添加方法。
一个方法必须具有与其泛型相同的参数。这是通过 R CMD 检查在包中强制执行的,但即使不创建包,这也是一个很好的实践。
Object styles
这里用length()
函数介绍一下不同类的方法风格。当length()
函数作用于向量时,返回向量的长度。当作用在其他如dataframe类时,返回的是list的长度。
- Record style object:list中的元素等长。例如
POSIXlt
类:
<- as.POSIXlt(ISOdatetime(2020, 1, 1, 0, 0, 1:3))
x
x#> [1] "2020-01-01 00:00:01 UTC" "2020-01-01 00:00:02 UTC"
#> [3] "2020-01-01 00:00:03 UTC"
length(x)
#> [1] 3
length(unclass(x))
#> [1] 11
1]] # the first date time
x[[#> [1] "2020-01-01 00:00:01 UTC"
unclass(x)[[1]] # the first component, the number of seconds
#> [1] 1 2 3
- Data frame
<- data.frame(x = 1:100, y = 1:100)
x length(x)
#> [1] 2
nrow(x)
#> [1] 100
- Scalar object: 使用一个list表示一个单一的对象。例如:
lm
对象
<- lm(mpg ~ wt, data = mtcars)
mod length(mod)
#> [1] 12
更多有关Object style2的内容可参考vctrs包。
Inheritance
S3类的方法“继承”有由下面三种方式实现:
class
属性可以是一个向量。
class(ordered("x"))
#> [1] "ordered" "factor"
class(Sys.time())
#> [1] "POSIXct" "POSIXt"
- 如果第一个类(class向量)没有方法定义,R 会自动向下寻找。
s3_dispatch(print(ordered("x")))
#> print.ordered
#> => print.factor
#> * print.default
s3_dispatch(print(Sys.time()))
#> => print.POSIXct
#> print.POSIXt
#> * print.default
- 使用
NextMethod()
可以访委托方法给已存在的方法。
# 注意`->`
s3_dispatch(ordered("x")[1])
#> [.ordered
#> => [.factor
#> [.default
#> -> [ (internal)
s3_dispatch(Sys.time()[1])
#> => [.POSIXct
#> [.POSIXt
#> [.default
#> -> [ (internal)
S3面向对象没有对子类和父类之间的关系施加限制,在创建一个子类时,推荐:
- 子类的base type与父类保持一致
- 子类的属性包含(继承)父类的属性
NextMethod()
NextMethod ()
是继承中最难理解的部分,所以我们从一个最常用的[
的具体示例开始。我们首先创建一个简单的类:一个在打印时隐藏其输出的秘密类:
<- function(x = double()) {
new_secret stopifnot(is.double(x))
structure(x, class = "secret")
}
<- function(x, ...) {
print.secret print(strrep("x", nchar(x)))
invisible(x)
}
<- new_secret(c(15, 1, 456))
x
x#> [1] "xx" "x" "xxx"
上面代码运行成功,但secret类没有定义[
方法。
s3_dispatch(x[1])
#> [.secret
#> [.default
#> => [ (internal)
1]
x[#> [1] 15
下面直接定义的[.secret
方法会陷入无限循环:
`[.secret` <- function(x, i) {
new_secret(x[i])
}
我们需要额外的步骤,先去掉x的类属性,取完值后再重新定义类:
`[.secret` <- function(x, i) {
<- unclass(x)
x new_secret(x[i])
}1]
x[#> [1] "xx"
上面的方法虽然有效,但会额外的创建x
对象,造成资源浪费。更好的方法是使用NextMethod()
方法。
`[.secret` <- function(x, i) {
new_secret(NextMethod())
}1]
x[#> [1] "xx"
s3_dispatch(x[1])
#> => [.secret
#> [.default
#> -> [ (internal)
=>
表示调用了[.secret
, 但NextMethod()
将方法委托于底层的内部[
方法,如->
所示。
NextMethod()
在寻找委托方法的类时,会根据全局变量.Class
来判断,内部的类型改变无效,例如:下面的结果返回的是a2
。
<- function(x) UseMethod("generic2")
generic2 <- function(x) "a1"
generic2.a1 <- function(x) "a2"
generic2.a2 <- function(x) {
generic2.b class(x) <- "a1"
NextMethod()
}
generic2(structure(list(), class = c("b", "a2")))
#> [1] "a2"
Allowing subclassing
当你创建一个类时,你需要决定是否允许可以存在一个子类,因为允许子类会要求你再创建构造函数和方法时作出一些额外的工作。
例如,允许子类后,父类的构造函数要添加额外的参数——...
,class
。
<- function(x, ..., class = character()) {
new_secret stopifnot(is.double(x))
structure(
x,
...,class = c(class, "secret")
) }
然后,子类的构造函数可以直接调用父类的构造函数,并添加额外的参数。
<- function(x) {
new_supersecret new_secret(x, class = "supersecret")
}
<- function(x, ...) {
print.supersecret print(rep("xxxxx", length(x)))
invisible(x)
}
<- new_supersecret(c(15, 1, 456))
x2
x2#> [1] "xxxxx" "xxxxx" "xxxxx"
如果允许添加子类,方法同样需要额外的工作,否则方法始终返回父类。
`[.secret` <- function(x, ...) {
new_secret(NextMethod())
}1:3]
x2[#> [1] "xx" "x" "xxx"
`[.secret` <- function(x, ...) {
new_secret(NextMethod(), class = class(x))
}1:3]
x2[#> [1] "xxxxx" "xxxxx" "xxxxx"
我们也可以使用vctrs::vec_restore()
泛型函数,为secret类添加不同类时的返回结果。
# `to` 参数用来传递类的其他属性。
<- function(x, to, ...) new_secret(x)
vec_restore.secret <- function(x, to, ...) new_supersecret(x)
vec_restore.supersecret
`[.secret` <- function(x, ...) {
::vec_restore(NextMethod(), x)
vctrs
}1:3]
x2[#> [1] "xxxxx" "xxxxx" "xxxxx"
Dispatch details
S3 and base types
S3面向对象系统中的泛型函数在作用于 base type 时,不会根据calss()
返回的类进行方法派发。
class(matrix(1:5))
#> [1] "matrix" "array"
s3_dispatch(print(matrix(1:5)))
#> print.matrix
#> print.integer
#> print.numeric
#> => print.default
<- 1:5
x1 class(x1)
#> [1] "integer"
s3_dispatch(mean(x1))
#> mean.integer
#> mean.numeric
#> => mean.default
<- structure(x1, class = "integer")
x2 class(x2)
#> [1] "integer"
s3_dispatch(mean(x2))
#> mean.integer
#> => mean.default
base type 的方法派发根据是其implicit class。implicit class 有三种组成:
- 当对象有维度时,“array”, “matrix”。
typeof()
的结果。- 当对象是”integer”或”double”时,“numeric”。
implicit class 只能由sloop::s3_class()
获取。
s3_class(matrix(1:5))
#> [1] "matrix" "integer" "numeric"
Internal generics
base R 中的一些函数,如[
,sum()
,cbind()
等被称为internal generics。因为它们不使用UseMethod()
,而是C语言中的DispatchGroup()
或DispatchOrEval()
。使用s3_dispatch()
时,会显示为(internal)
。
s3_dispatch(Sys.time()[1])
#> => [.POSIXct
#> [.POSIXt
#> [.default
#> -> [ (internal)
Group generics
Group generics 与 internal generics 类似,只存在于 base R 中,你自己无法构建。
base R 中存在4大类 Group generics:
- Math:
abs()
,sign()
,sqrt()
,floor()
,cos()
,sin()
,log()
, and more (see?Math
for the complete list). - Ops:
+
,-
,*
,/
,^
,%%
,%/%
,&
,|
,!
,==
,!=
,<
,<=
,>=
, and>
. - Summary:
all()
,any()
,sum()
,prod()
,min()
,max()
, andrange()
. - Complex:
Arg()
,Conj()
,Im()
,Mod()
,Re()
.
当你为你的类定义了某个Group generic,这个Group generic内的所有方法都会被覆盖。当某个方法不存在时,会从组内寻找。
s3_dispatch(sum(Sys.time()))
#> sum.POSIXct
#> sum.POSIXt
#> sum.default
#> => Summary.POSIXct
#> Summary.POSIXt
#> Summary.default
#> -> sum (internal)
很多 Group generics 中都使用了NextMethod()
。例如期,我们用abs()
来计算一个difftime
对象。
<- as.difftime(10, units = "mins")
y s3_dispatch(abs(y))
#> abs.difftime
#> abs.default
#> => Math.difftime
#> Math.default
#> -> abs (internal)
Math.difftime()
大致如下:
<- function(x, ...) {
Math.difftime new_difftime(NextMethod(), units = attr(x, "units"))
}
Double dispatch
Ops Group generics 使用了 double dispatch。这保证了a + b
和b + a
的计算结果一致。例如:
<- as.Date("2017-01-01")
date <- 1L
integer
+ integer
date #> [1] "2017-01-02"
+ date
integer #> [1] "2017-01-02"
因为要同时为两种类进行方法派发,所以就会出现下面三种情况:
- 如果方法相同,无所谓使用哪个方法。
- 如果方法不同,R 最终回归到内部方法,并附带一个警告。
- 如果有一个方法是“internal”,则R使用另外一种方法。